Celestin Apprentice 2/Apprentice-Release2.iso/Tools/Languages/MacMarlais 0.5.3/dylan.dyl

Text File | 1994-09-19 | 77.0 KB | 2,622 lines | [TEXT/Mrls]

module:        dylan
authors:    Brent Benson
            Joseph N. Wilson ([e-mail])
            Patrick C. Beard ([e-mail])
copyright:    Copyright, 1993, Brent Benson.  All Rights Reserved.
            0.4 & 0.5 Revisions Copyright 1994, Joseph N. Wilson.  All Rights Reserved.

//
// init.dyl
//
//
// Copyright, 1993, Brent Benson.  All Rights Reserved.
// 0.4 & 0.5 Revisions Copyright 1994, Joseph N. Wilson.  All Rights Reserved.
//
// "Translated" to DIRM syntax by Patrick C. Beard ([e-mail])
//
// Permission to use, copy, and modify this software and its
// documentation is hereby granted only under the following terms and
// conditions.  Both the above copyright notice and this permission
// notice must appear in all copies of the software, derivative works
// or modified version, and both notices must appear in supporting
// documentation.  Users of this software agree to the terms and
// conditions set forth in this notice.
//
// [e-mail]
// http://www.cis.ufl.edu/~jnw/
//
//

//(define-method make ((c <class>) #rest args #key #all-keys)
//  (%make c args))

define method make (c :: <class>, #rest args, #key, #all-keys)
    %make(c, args);
end method;

// pcb:  what happens to all-keys in old version?

// (define instance? (method (obj (t <type>)) (%instance? obj t)))

define constant instance? =
    method (obj, typ :: <type>)
        %instance?(obj, typ);
    end;

//(define-method as ((c <class>) (obj <object>))
//  (if (object-class obj c)
//      obj
//      (error "No method to coerce ~a to ~a~%" obj c)))

define method as (c :: <class>, obj :: <object>)
    if (object-class(obj, c))
        obj;
    else
        error("No method to coerce ~a to ~a~%", obj, c);
    end;
end method;

//(define-method as ((kc (singleton <keyword>)) (s <symbol>)) (%symbol->keyword s))
define method as (kc == <keyword>, s :: <symbol>)
    %symbol->keyword(s);
end method;

//(define-method as ((sc (singleton <symbol>)) (k <keyword>)) (%keyword->symbol k))
define method as (sc == <symbol>, k :: <keyword>)
    %keyword->symbol(k);
end method;

//(define-method as ((sc (singleton <string>)) (s <symbol>)) (%symbol->string s))
define method as (sc == <string>, s :: <symbol>)
    %symbol->string(s);
end method;

//(define-method as ((sc (singleton <symbol>)) (s <string>)) (%string->symbol s))
define method as (sc == <symbol>, s :: <string>)
    %string->symbol(s);
end method;

// (define-method error ((msg <string>) #rest args) (%apply %error (%pair msg args)))
define method error (msg :: <string>, #rest args)
    %apply(%error, %pair(msg, args));
end method;

//(define-method warning ((msg <string>) #rest args) (%apply %warning (%pair msg args)))
define method warning (msg :: <string>, #rest args)
    %apply(%warning, %pair(msg, args));
end method;

//(define-method cerror (#rest args)
//  (format #t "cerror: called with arguments ~A" args))
define method cerror (#rest args)
    format(#t, "cerror: called with arguments ~A", args);
end method;

//(define-method signal (#rest args)
//  (%signal-error-jump))

//(define-method initialize (instance #key #all-keys))
define method initialize (instance, #key, #all-keys)
    warning("default initialize method here");
end method;

//
// streams
//

//(define-method open-input-file ((s <string>)) (%open-input-file s))
define method open-input-file (s :: <string>) %open-input-file(s); end method;

//(define-method open-output-file ((s <string>)) (%open-output-file s))
define method open-output-file (s :: <string>) %open-output-file(s); end method;

//(define-method close-stream ((s <stream>)) (%close-stream s))
define method close-stream (s :: <stream>) %close-stream(s); end method;

//(define-method eof-object? (obj) (%eof-object? obj))
define method eof-object? (obj) %eof-object?(obj); end method;

//(define-method standard-input () (%standard-input))
define method standard-input () %standard-input(); end method;

//(define-method standard-output () (%standard-output))
define method standard-output () %standard-output(); end method;

//(define-method standard-error () (%standard-error))
define method standard-error () %standard-error(); end method;

//(define-method print (obj) (%print obj))
define method print (obj) %print(obj) end method;

//(define-method princ (obj) (%princ obj))
define method princ (obj) %princ(obj) end method;

//(define-method format (stream (s <string>) #rest args) (%format stream s args))
define method format (stream, s :: <string>, #rest args)
    %format(stream, s, args);
end method;

//(define-method write-char ((c <character>) #rest maybe-stream)
//  (%write-char c maybe-stream))
define method write-char (c :: <character>, #rest maybe-stream)
    %write-char(c, maybe-stream);
end method;

//(define-method read (#rest stream)
//  (if (empty? stream)
//      (%read)
//      (%read (head stream))))
define method read (#rest stream)
    if (empty?(stream))
        %read();
    else
        %read(head(stream));
    end if;
end method;

//(define-method read-char (#rest stream)
//  (if (empty? stream)
//      (%read-char)
//      (%read-char (head stream))))
define method read-char (#rest stream)
    if (empty?(stream))
        %read-char();
    else
        %read-char(head(stream));
    end if;
end method;

//
// functions
//
//(define-method generic-function-methods ((gf <generic-function>))
//  (%generic-function-methods gf))
define method generic-function-methods (gf :: <generic-function>)
    %generic-function-methods(gf);
end method;

//(define-method add-method ((gf <generic-function>) (method <method>))
//  (%add-method gf method))
define method add-method (gf :: <generic-function>, meth :: <method>)
    %add-method(gf, meth);
end method;

//(define-method generic-function-mandatory-keywords ((gf <generic-function>))
//  (%generic-function-mandatory-keywords gf))
define method generic-function-mandatory-keywords (gf :: <generic-function>)
    %generic-function-mandatory-keywords(gf);
end method;


//(define-method function-specializers ((m <method>)) (%function-specializers m))
define method function-specializers (meth :: <method>)
    %function-specializers(gf, meth);
end method;


//(define-method method-specializers ((m <method>))
//  (warning "method specializers is now function-specializers")
//  (%function-specializers m))

//(define-method function-arguments ((f <function>)) (%function-arguments f))
define method function-arguments (f :: <function>)
    %function-arguments(f);
end method;

//(define-method applicable-method? ((m <method>) #rest args)
//  (%apply %applicable-method? (%pair m args)))
define method applicable-method? (m :: <method>, #rest args)
    %apply(%applicable-method?, %pair(m, args));
end method;

//(define-method sorted-applicable-methods ((gf <generic-function>) #rest args)
//  (%apply %sorted-applicable-methods (%pair gf args)))
define method sorted-applicable-methods (gf :: <generic-function>, #rest args)
    %apply(%sorted-applicable-methods, %pair(gf, args));
end method;


//(define-method find-method ((gf <generic-function>) #rest sample-arguments)
//  (%find-method gf sample-arguments))
define method find-method (gf :: <generic-function>, #rest sample-args)
    %find-method(gf, sample-args);
end method;

//(define-method remove-method ((gf <generic-function>) (method <method>))
//  (%remove-method gf method))
define method remove-method (gf :: <generic-function>, meth :: <method>)
    %remove-method(gf, meth);
end method;

//(define-method make ((gftype (singleton <generic-function>))
//             #key required rest key all-keys)
//  ; if with no else below
//  (and (instance? required <number>)
//       (set! required (make <list>
//                size: required
//                fill: <object>)))
//  (if (instance? required <list>)
//      (%generic-function-make required rest key all-keys)
//      (error "make: bad key value" required: required)))

define method make (gftype == <generic-function>, #key required, rest, key, all-keys)
    // if with no else below
    if (instance?(required, <number>))
        required := make(<list>,  size: required, fill: <object>);
    end if;
    if (instance?(required, <list>))
        %generic-function-make(required, rest, key, all-keys);
    else
        error("make: bad key value", required: required);
    end if;
end method;

//(define-method debug-name-setter ((m <method>) (s <symbol>)) (%debug-name-setter m s))
define method debug-name-setter (m :: <method>, s :: <symbol>)
    %debug-name-setter(m, s);
end method;

//(define-method apply ((f <function>) #rest args)
//  ; pretty kludgy -- hacked in late at night to make apply work for
//  ; arbitrary <sequence> type as last arg. -- jnw
//  (bind-methods ((collect-args (args)
//          (cond
//           ((empty? args) '())
//           ((empty? (tail args))
//            (if (not (instance? (head args) <sequence>))
//            (error "apply: last arg must be a sequence" (head args))
//            (head args)))
//           (else:
//            (bind ((res (list)))
//              (for ((state (initial-state args)
//                       (next-state args state)))
//                   ((not state))
//                   (set! res (pair (current-element args state)
//                           res)))
//              (bind ((argseq (head res)))
//                   (set! res (tail res))
//                   (for ((state (initial-state argseq)
//                        (next-state argseq state)))
//                    ((not state) res)
//                    (set! res
//                      (pair (current-element argseq state)
//                        res))))
//              (reverse! res))))))
//        (%apply f (collect-args args))))

define method apply (f :: <function>, #rest args)
    // flatten all args into a single list.
    local method collect-args (args)
        case
        empty?(args) => #();
        empty?(tail(args)) =>
            if (~instance?(head(args), <sequence>))
                error("apply:  last arg must be a sequence", head(args));
            else
                head(args);
            end if;
        otherwise =>
            let res = #();
            for (state = initial-state(args) then next-state(args, state) until (~state) )
                res := pair(current-element(args, state), res);
            end for;
            // make sure that last argument is a sequence here.
            if (~instance?(head(res), <sequence>))
                error("apply:  last arg must be a sequence", head(args));
            end if;
            let argseq = head(res);
            res := tail(res);
            for (state = initial-state(argseq) then next-state(argseq, state) until (~state) )
                res := pair(current-element(argseq, state), res);
            end for;
            reverse!(res);
        end case;
    end collect-args;
    %apply(f, collect-args(args));
end method;

//
// comparisons.
//

//
// according to IRM, = should be a generic function so it can be extended
// by user classes. most primitive version just checks if operands are ==.
//

//(define-method binary= (obj1 obj2) (id? obj1 obj2))

define method \= (o1, o2)
    o1 == o2;
end method;

// \~= just calls \= and complements the result.

define constant \~= =
    method (o1, o2)
        ~(o1 = o2);
    end;

// IRM definition:  < is a generic function.

define method \< (o1, o2)
    error("objects have no intrinsic ordering.");
end;

// >, <=, and >= are all defined by <.

define constant \> =
    method (o1, o2)
        o2 < o1;
    end;

define constant \<= =
    method (o1, o2)
        ~(o2 < o1);
    end;

define constant \>= =
    method (o1, o2)
        ~(o1 < o2);
    end;

//(define-method =hash (obj) (%=hash obj))

define method =hash (obj)
    %=hash(obj);
end method;

//
// classes
//

//(define subtype? (method ((t1 <type>) (t2 <type>))
//             (%subtype? t1 t2)))

define constant subtype? =
    method (t1 :: <type>, t2 :: <type>)
        %subtype?(t1, t2);
    end;

//(define subclass?
//  (method (c1 c2)
//      (princ "warning: subclass is deprecated by Dylan Design Note 5.")
//      (%subtype? c1 c2)))

//(define all-superclasses (method ((c <class>))
//                 (%all-superclasses c)))
define constant all-superclasses =
    method (c :: <class>)
        %all-superclasses(c);
    end;

//(define direct-superclasses (method ((c <class>))
//                    (%direct-superclasses c)))
define constant direct-superclasses =
    method (c :: <class>)
        %direct-superclasses(c);
    end;

//(define direct-subclasses (method ((c <class>))
//                  (%direct-subclasses c)))
define constant direct-subclasses =
    method (c :: <class>)
        %direct-subclasses(c);
    end;

//(define-method seal ((c <class>))
//  (%seal c))
define method seal (c :: <class>)
    %seal(c);
end method;

//(define slot-initialized?
//  (method (obj slot)
//      (not (id? (slot obj) %uninitialized-slot-value))))
define constant slot-initialized? =
    method (obj, slot)
        ~(id? (slot(obj), %uninitialized-slot-value));
    end;

//
// types
//
// We need to leave this out for now because we haven't thought about
// how to compare limited types in sorting applicable gf methods.

// limited <integer>

//(define-method limited ((int (singleton <integer>))
//            #rest args
//                #key min max)
//  (%limited-integer args))

// 24 May 1994
// limited <collection>

//;(define-method limited ((coll (singleton <collection>))
//;            #rest args
//;            #key
//;            (of <type>)
//;            (size (limited <integer> min: 0)))
//;  (if (and (not (sealed? coll)) (instantiable? coll))
//;      (%limited-collection args)
//;      (error "limited: collection either sealed or not instantiable:" coll)))


// union types
//(define-method union ((t1 <type>) (t2 <type>))
//  (%union-type (list t1 t2)))
define method union (t1 :: <type>, t2 :: <type>)
    %union-type(list(t1, t2));
end method;

//(define-method union* (#rest args)
//  (union (first args) (apply union (tail args))));
define method union* (#rest args)
    union(head(args), apply(union, tail(args)));
end method;

//
// collections
//

//
// collection.dyl - portable collection functions
//
// Brent Benson
//

//
// collections
//
// (size collection) => integer or #f
// (class-for-copy collection) => class
// (empty? collection) => boolean
// (do procedure collection #rest more-collections) => #f
// (map procedure collection #rest more-collections) => new-collection
// (map-as class procedure collection #rest more-collections) => new-collection
// (map-into mutable-col procedure collection #rest more-cols) => mutable-col
// (any? procedure collection #rest more-collections) => value
// (every? procedure collection #rest more-collections) => boolean
// (reduce procedure initial-value collection) => value
// (reduce1 procedure collection) => value
// (member? value collection #key test) => boolean
// (find-key collection procedure #key skip failure) => key
// (replace-elements! mutable-col predicate new-value-fn #key count) => mutable-col
// (fill! mutable-collection value #key start end)

//(define-generic-function element ((c <collection>) key #rest rest))
define generic element (c :: <collection>, key, #rest rest);

//(define-method size ((c <collection>))
//  (for ((state (initial-state c) (next-state c state))
//    (the-size 0 (+ the-size 1)))
//       ((not state) the-size)))

define method size (c :: <collection>)
    let the-size = 0;
    for (state = initial-state(c) then next-state(c, state) until (~state))
        the-size := the-size + 1;
    finally
        the-size;
    end for;
end method;

//(define-method class-for-copy ((c <collection>))
//  (object-class c))

define method class-for-copy (c :: <collection>)
    object-class(c);
end method;

//
// Added to satisfy implementation of every? below
//

//(define-method class-for-copy ((p <pair>))
//  <list>)

define method class-for-copy (p :: <pair>)
    <list>;
end method;

//(define-method class-for-copy ((b <byte-string>)) <byte-string>)

define method class-for-copy (p :: <byte-string>)
    <byte-string>;
end method;

//(define-method empty? ((c <collection>))
//  (if (initial-state c)
//      #f
//      #t))

define method empty? (c :: <collection>)
    if (initial-state(c))
        #f;
    else
        #t;
    end if;
end method;

// map1 and map2 aren't part of the spec, but are included here
// for bootstrapping purposes.
//
//(define-method map1 ((f <function>) (c <collection>))
//  (bind ((class (class-for-copy c))
//     (new (make class size: (size c))))
//    (for ((state (initial-state c) (next-state c state))
//      (i 0 (+ i 1)))
//    ((not state) new)
//      (set! (element new i) (f (current-element c state))))))

define method map1 (f :: <function>, c :: <collection>)
    let cl = class-for-copy(c);
    let new = make(class, size: size(c));
    let index = 0;
    for (state = initial-state(c) then next-state(c, state) until (~state))
        new[index] := f(c[index]);
        index := index + 1;
    finally
        new;
    end for;
end method;

//(define-method map2 ((f <function>) (c1 <collection>) (c2 <collection>))
//  (bind ((class (class-for-copy c1))
//     (new (make class size: (size c1))))
//    (for ((state1 (initial-state c1) (next-state c1 state1))
//      (state2 (initial-state c2) (next-state c2 state2))
//      (i 0 (+ i 1)))
//    ((not state1) new)
//      (set! (element new i) (f (current-element c1 state1)
//                   (current-element c2 state2))))))

define method map2 (f :: <function>, c1 :: <collection>, c2 :: <collection>)
    let cl = class-for-copy(c1);
    let new = make(class, size: size(c1));
    let index = 0;
    for (st1 = initial-state(c1) then next-state(c1, st1),
        st2 = initial-state(c2) then next-state(c2, st2)
        until (~st1))
        new[index] := f(c1[index], c2[index]);
        index := index + 1;
    finally
        new;
    end for;
end method;

//(define-method do ((f <function>) (c <collection>) #rest more-collections)
//  (bind ((collections (pair c more-collections)))
//    (for ((states (map1 initial-state collections)
//              (map2 next-state collections states)))
//         ((not (head states)) #f)
//    (apply f (map2 current-element collections states)))))

define method do (f :: <function>, c :: <collection>, #rest more-collections)
    let collections = pair(c, more-collections);
    for (states = map1(initial-state, collections)
        then     map2(next-state, collections, states) until (~head(states)))
        apply(f, map2(current-element, collections, states));
    finally
        #f;
    end for;
end method;

//(define-method map ((f <function>) (c <collection>) #rest more-collections)
//  (bind ((collections (pair c more-collections))
//     (class (class-for-copy c))
//     (new (make class size: (size c))))
//    (for ((states (map1 initial-state collections)
//          (map2 next-state collections states))
//      (i 0 (+ i 1)))
//    ((not (head states)) new)
//      (set! (element new i) (apply f (map2 current-element collections states))))))

//(define-method map-as ((class <class>) (f <function>) (c <collection>) #rest more-collections)
//  (bind ((collections (pair c more-collections))
//     (new (make class size: (size c))))
//    (for ((states (map1 initial-state collections)
//          (map2 next-state collections states))
//      (i 0 (+ i 1)))
//    ((not (head states)) new)
//      (set! (element new i) (apply f (map2 current-element collections states))))))

//(define-method map-into ((mc <mutable-collection>) (f <function>) #rest more-collections)
//  (bind ((collections (pair mc more-collections)))
//    (for ((states (map1 initial-state collections)
//          (map2 next-state collections states))
//      (i 0 (+ i 1)))
//    ((not (head states)) mc)
//      (set! (element mc i) (apply f (map2 current-element collections states))))))

//(define-method any? ((f <function>) (c <collection>) #rest more-collections)
//  (bind ((collections (pair c more-collections))
//     (ret #f))
//    (for ((states (map1 initial-state collections)
//          (map2 next-state collections states))
//      (i 0 (+ i 1)))
//    ((or (not (head states)) ret) ret)
//      (set! ret (apply f (map2 current-element collections states))))))

//(define-method every? ((f <function>) (c <collection>) #rest more-collections)
//  (bind ((collections (pair c more-collections))
//     (ret #t))
//    (for ((states (map1 initial-state collections)
//          (map2 next-state collections states))
//      (i 0 (+ i 1)))
//    ((or (not (head states)) (not ret)) ret)
//      (set! ret (apply f (map2 current-element collections states))))))

//(define-method reduce ((f <function>) init-value (c <collection>))
//  (bind ((value init-value))
//    (for ((state (initial-state c) (next-state c state)))
//    ((not state) value)
//      (set! value (f value (current-element c state))))))

define method reduce (f :: <function>, init-value, c :: <collection>)
    let value = init-value;
    for (state = initial-state(c) then next-state(c, state) until (~state))
        value := f(value, current-element(c, state));
    finally
        value;
    end for;
end method;

//(define-method reduce1 ((f <function>) (c <collection>))
//  (bind ((first-state (initial-state c))
//     (value (current-element c first-state)))
//    (for ((state (next-state c first-state) (next-state c state)))
//    ((not state) value)
//      (set! value (f value (current-element c state))))))

define method reduce1 (f :: <function>, c :: <collection>)
    let first-state = initial-state(c);
    let value = current-element(c, first-state);
    for (state = next-state(c, first-state) then next-state(c, state) until (~state))
        value := f(value, current-element(c, state));
    finally
        value;
    end for;
end method;

// for example:
// define method sum (l :: <list>) reduce1(\+, l); end method;
// sum(#(1,2,3) --> 6

//(define-method member? (value (c <collection>) #key (test id?))
//  (bind ((ret #f))
//    (for ((state (initial-state c) (next-state c state)))
//    ((or (not state) ret) ret)
//      (set! ret (test (current-element c state) value)))))

define method member? (value, c :: <collection>, #key test (id?))
    let ret = #f;
    for (state = initial-state(c) then next-state(c, state) until (~state | ret))
        ret := test(current-element(c, state), value);
    finally
        ret;
    end for;
end method;

//(define-method find-key ((c <collection>) (f <function>) #key (skip 0) (failure #f))
//  (bind ((keys (key-sequence c)))
//    (bind-exit (exit)
//      (for ((state (initial-state keys) (next-state keys state))
//        (i 0 (+ i 1)))
//      ((not state) failure)
//    (when (>= i skip)
//      (bind ((cur (current-element keys state)))
//        (when (f (element c cur))
//          (exit cur))))))))

//(define-method replace-elements! ((mc <mutable-collection>)
//                  (pred <function>)
//                  (new-value-fn <function>)
//                  #key (count #f))
//  (for ((state (initial-state mc) (next-state mc state))
//    (cur-count 0 (+ cur-count 1)))
//      ((or (not state) (> cur-count count)) mc)
//    (if (pred (current-element mc state))
//    (set! (current-element mc state) (new-value fn (current-element mc state))))))

//(define-method fill! ((mc <mutable-collection>) value)
//  (for ((state (initial-state mc) (next-state mc state)))
//      ((not state) mc)
//    (print value)
//    (set! (current-element mc state) value)))

//(define-method fill! ((ms <mutable-sequence>) value #key (start 0) (end (size ms)))
//  (for ((i start (+ i 1)))
//      ((>= i end) ms)
//    (set! (element ms i) value)))

define method fill! (ms :: <mutable-sequence>, value, #key start (0), finish (size(ms)))
    for (i :: <integer> from start to finish)
        ms[i] := value;
    finally
        ms;
    end for;
end method;

//
// sequences
//
// (add sequence new-element) => new-sequence
// (add! sequence1 new-element) => sequence2
// (add-new sequence new-element #key test) => new-sequence
// (add-new! sequence1 new-element #key test) => sequence2
// (remove sequence value #key test count) => new-sequence
// (remove! sequence1 value #key test count) => sequence2
// (choose predicate sequence) => new-sequence
// (choose-by predicate test-sequence value-sequence) => new-sequence
// (intersection sequence1 sequence2 #key test) => new-sequence
// (union sequence1 sequence2 #key test) => new-sequence
// (remove-duplicates sequence #key test) => new-sequence
// (remove-duplicates! sequence1 #key test) => sequence2
// (copy-sequence source #key start end) => new-sequence
// (concatenate-as class sequence1 #rest more-sequences) => new-sequence
// (concatenate sequence1 #rest sequences) => new-sequence
// (replace-subsequence! mutable-sequence insert-sequence #key start) => sequence
// (reverse sequence) => new-sequence
// (reverse! sequence1) => sequence2
// (sort sequence #key test stable) => new-sequence
// (sort! sequence1 #key test stable) => sequence2
// (first sequence) => value
// (second sequence) => value
// (third sequence) => value
// (first-setter sequence new-value) => new-value
// (second-setter sequence new-value) => new-value
// (third-setter sequence new-value) => new-value
// (last sequence) => value
// (subsequence-position big pattern #key test count) => index
//
// others

//(define-method add ((s <sequence>) new-el)
//  (bind ((class (class-for-copy s))
//     (new (make class size: (+ (size s) 1))))
//    (for ((state1 (initial-state s) (if state1 (next-state s state1) #f))
//      (state2 (initial-state new) (next-state new state2)))
//    ((not state2) new)
//      (if state1
//      (set! (current-element new state2) (current-element s state1))
//      (set! (current-element new state2) new-el)))))

//(define-method add! ((s <sequence>) new-el)
//  (bind ((class (class-for-copy s))
//     (new (make class size: (+ (size s) 1))))
//    (for ((state1 (initial-state s) (if state1 (next-state s state1) #f))
//      (state2 (initial-state new) (next-state new state2)))
//    ((not state2) new)
//      (if state1
//      (set! (current-element new state2) (current-element s state1))
//      (set! (current-element new state2) new-el)))))

//(define-method add-new ((s <sequence>) new-el #key (test id?))
//  (if (member? new-el s test: test)
//      s
//      (add s new-el)))

//(define-method add-new! ((s <sequence>) new-el #key (test id?))
//  (if (member? new-el s test: test)
//      s
//      (add! s new-el)))

//(define-method remove ((s <sequence>) value #key (test id?) count)
//  (bind-methods ((new-as-list (s state cur-count)
//           (cond
//            ((not state) '())
//            ((and count (>= cur-count count))
//             (pair (current-element s state)
//               (new-as-list s (next-state s state) cur-count)))
//            ((test (current-element s state) value)
//             (new-as-list s (next-state s state) (+ cur-count 1)))
//            (else:
//             (pair (current-element s state)
//               (new-as-list s (next-state s state) cur-count))))))
//    (bind ((class (class-for-copy s))
//       (new-list (new-as-list s (initial-state s) 0)))
//      (as class new-list))))

//(define-method remove! ((s <sequence>) value #key (test id?) count)
//  (bind-methods ((new-as-list (s state cur-count)
//           (cond
//            ((not state) '())
//            ((and count (>= cur-count count))
//             (pair (current-element s state)
//               (new-as-list s (next-state s state) cur-count)))
//            ((test (current-element s state) value)
//             (new-as-list s (next-state s state) (+ cur-count 1)))
//            (else:
//             (pair (current-element s state)
//               (new-as-list s (next-state s state) cur-count))))))
//    (bind ((class (class-for-copy s))
//       (new-list (new-as-list s (initial-state s) 0)))
//      (as class new-list))))

//(define-method choose ((pred <function>) (s <sequence>))
//  (bind-methods ((new-as-list (s state)
//                  (cond
//           ((not state) '())
//           ((pred (current-element s state))
//            (pair (current-element s state)
//              (new-as-list s (next-state s state))))
//           (else: (new-as-list s (next-state s state))))))
//    (bind ((class (class-for-copy s))
//       (new-list (new-as-list s (initial-state s))))
//      (as class new-list))))

//(define-method choose-by ((pred <function>) (ts <sequence>) (vs <sequence>))
//  (bind-methods ((new-as-list (ts ts-state vs vs-state)
//                  (cond
//           ((not state1) '())
//           ((pred (current-element ts ts-state))
//            (pair (current-element vs vs-state)
//              (new-as-list ts (next-state ts ts-state)
//                       vs (next-state vs vs-state))))
//           (else: (new-as-list ts (next-state ts ts-state)
//                       vs (next-state vs vs-state))))))
//    (bind ((class (class-for-copy s))
//       (new-list (new-as-list ts (initial-state ts)
//                  vs (initial-state vs))))
//      (as class new-list))))

//(define-method intersection ((s1 <sequence>) (s2 <sequence>) #key (test id?))
//  (bind ((new-list '())
//     (class (class-for-copy s1)))
//    (for ((state1 (initial-state s1) (next-state s1 state1)))
//    ((not state1))
//      (bind ((el (current-element s1 state1)))
//    (when (member? el s2 test: test)
//       (set! new-list (pair el new-list)))))
//    (as class new-list)))

//(define-method union ((s1 <sequence>) (s2 <sequence>) #key (test id?))
//  (bind ((new (copy-sequence s2)))
//    (for ((state1 (initial-state s1) (next-state s1 state1)))
//    ((not state1) new)
//      (set! new (add-new! new (current-element s1 state1) test: test)))))

//(define-method remove-duplicates ((s <sequence>) #key (test id?))
//  (bind ((new-list '()))
//    (for ((state1 (initial-state s) (next-state s state1)))
//    ((not state1))
//      (bind ((already-there #f))
//    (for ((state2 (initial-state s) (next-state s state2)))
//        ((or already-there (not state)))
//      (if (test (current-element s state1) (current-element s state2))
//          (set! already-there #t)))
//    (if (not already-there)
//        (set! new-list (pair (current-element s state1))))))
//    (as (class-for-copy s) new-list)))

//(define-method remove-duplicates! ((s <sequence>) #key (test id?))
//  (bind ((new-list '()))
//    (for ((state1 (initial-state s) (next-state s state1)))
//    ((not state1))
//      (bind ((already-there #f))
//    (for ((state2 (initial-state s) (next-state s state2)))
//        ((or already-there (not state)))
//      (if (test (current-element s state1) (current-element s state2))
//          (set! already-there #t)))
//    (if (not already-there)
//        (set! new-list (pair (current-element s state1))))))
//    (as (class-for-copy s) new-list)))

//(define-method copy-sequence ((s <sequence>) #key (start 0) (end (size s)))
//  (bind ((new (make (class-for-copy s) size: (- end start))))
//    (for ((state1 (initial-state s) (next-state s state1))
//      (state2 (initial-state new) (next-state new state2)))
//    ((not state1) new)
//      (set! (current-element new state2) (current-element s state1)))))

//(define-method concatenate-as ((class <class>) (s <sequence>) #rest more-seq)
//  (bind ((new (apply concatenate s more-seq)))
//    (as class new)))

//(define-method concatenate ((s <sequence>) #rest more-seq)
//  (bind-methods ((help (s more)
//          (if (empty? more)
//              s
//              (help (concatenate2 s (head more))
//                (tail more))))
//         (concatenate2 ((s1 <sequence>) (s2 <sequence>))
//                  (bind ((size1 (size s1))
//             (size2 (size s2))
//             (new-size (+ size1 size2))
//             (new (make (class-for-copy s1) size: new-size)))
//            (for ((i 0 (+ i 1)))
//            ((>= i new-size) new)
//              (if (< i size1)
//              (set! (element new i) (element s1 i))
//              (set! (element new i) (element s2 (- i size1))))))))
//    (help s more-seq)))

//(define-method replace-subsequence! ((ms <mutable-sequence>)
//                     (is <sequence>)
//                     #key (start 0))
//  (for ((i 0 (+ i 1)))
//      ((>= i (size is)) ms)
//    (set! (element ms (+ i start)) (element is i))))

//(define-method reverse ((s <sequence>))
//  (bind ((seq-size (size s))
//     (new (make (class-for-copy s) size: seq-size)))
//    (for ((i 0 (+ i 1)))
//    ((>= i seq-size) new)
//      (set! (element new i) (element s (- seq-size i 1))))))

//
// check me
//

//(define-method reverse! ((s <sequence>))
//  (bind ((seq-size (size s))
//     (seq-size/2 (/ seq-size 2)))
//    (for ((i 0 (+ i 1)))
//    ((>= i seq-size/2) s)
//      (bind ((temp (element s i))
//         (j (- seq-size i 1)))
//    (element-setter s i (element s j))
//    (element-setter s j temp)))))

//(define-method sort ((s <sequence>) #key (test <) (stable #t))
//  (if (not stable)
//      (error "sort: cannot sort a non-stable sequence" s)
//      (sort! (copy-sequence s) test: test stable: stable)))

define method sort (s :: <sequence>, #key test (\<), stable (#t))
    if (~stable)
        error("sort: cannot sort a non-stable sequence", s);
    else
        sort!(copy-sequence(s), test: test, stable: stable);
    end if;
end method;

//(define-method sort! ((s <sequence>) #key (test <) (stable #t))
//  (if (not stable)
//      (error "sort!: cannot sort a non-stable sequence" s)
//      (error "sort!: unimplemented" s)))

define method sort! (s :: <sequence>, #key test (\<), stable (#t))
    if (~stable)
        error("sort: cannot sort a non-stable sequence", s);
    else
        error("sort!: unimplemented", s);
    end if;
end method;

//(define-method first ((s <sequence>) #key (default %default-object))
//  (element s 0 default: default))
//(define-method second ((s <sequence>) #key (default %default-object))
//  (element s 1 default: default))
//(define-method third ((s <sequence>) #key (default %default-object))
//  (element s 2 default: default))

define method first (s :: <sequence>, #key default (%default-object))
    element(s, 0, default: default);
end method;
define method second (s :: <sequence>, #key default (%default-object))
    element(s, 1, default: default);
end method;
define method third (s :: <sequence>, #key default (%default-object))
    element(s, 2, default: default);
end method;

//(define-method first-setter ((s <sequence>) el) (set! (element s 0) el))
//(define-method second-setter ((s <sequence>) el) (set! (element s 1) el))
//(define-method third-setter ((s <sequence>) el) (set! (element s 2) el))

define method first-setter (s :: <sequence>, el) s[0] := el; end method;
define method second-setter (s :: <sequence>, el) s[1] := el; end method;
define method third-setter (s :: <sequence>, el) s[2] := el; end method;

//(define-method last ((s <sequence>) #key (default %default-object))
//  (bind ((size (size s)))
//    (case size
//      ((0 #f) (if (id? default %default-object)
//              (if (= size 0)
//              (error "last applied to empty sequence")
//              (error "last applied to unbounded sequence"))
//              default))
//      (else: (element s (- size 1))))))

define method last (s :: <sequence>, #key default (%default-object))
    let sz = size(s);
    if (sz = 0 | sz = #f)
        if (id?(default, %default-object))
            if (sz = 0)
                error("last applied to empty sequence");
            else
                error("last applied to unbounded sequence");
            end if;
        else
            default;
        end if;
    else
        s[sz - 1];
    end if;
end method;

//(define-method last-setter ((s <sequence>) new-value)
//  (bind ((size (size s)))
//    (case size
//      ((0) (error "last-setter applied to empty sequence"))
//      ((#f) (error "last-setter applied to unbounded sequence"))
//      (else: (element-setter s (- size 1) new-value)))))

define method last-setter (s :: <sequence>, new-value)
    let sz = size(s);
    if (sz = 0)
        error("last-setter applied to empty sequence");
    else
        if (~sz)
            error("last-setter applied to unbounded sequence");
        else
            s[sz - 1] := new-value;
        end if;
    end if;
end method;

//(define-method subsequence-position (bit pattern #key (test id?) count) 'unimplemented)

//
// convert from one collection type to another
//
//(define-method as ((new-class <class>) (c <collection>))
//  (if (instance? c new-class)
//      c
//      (bind ((new (make new-class size: (size c))))
//    (for ((state1 (initial-state c) (next-state c state1))
//          (state2 (initial-state new) (next-state new state2)))
//       ((not state1) new)
//     (set! (current-element new state2) (current-element c state1))))))

//(define-method key-sequence ((s <sequence>))
//  (bind ((res '()))
//    (for ((state (initial-state s) (next-state s state))
//      (i 0 (+ i 1)))
//    ((not state) res)
//      (set! res (pair i res)))))

//(define-method binary= ((s1 <sequence>) (s2 <sequence>))
//   (for ((state1 (initial-state s1) (next-state s1 state1))
//     (state2 (initial-state s2) (next-state s2 state2)))
//    ((if (not state1)
//         #t
//         (not (binary= (current-element s1 state1)
//               (current-element s2 state2))))
//     (and (not state1) (not state2)))))

// end collection.dyl

//
// list.dyl - list operations
//
// Brent Benson
//

//
// list specific operations
//

//(define-method pair (car cdr) (%pair car cdr))
define method pair (car, cdr) %pair(car, cdr); end method;

//(define-method list (#rest els) els)
define method list (#rest els) els end method;

//(define-method head ((p <pair>)) (%head p))
define method head (p :: <pair>) %head(p); end method;

//(define-method tail ((p <pair>)) (%tail p))
define method tail (p :: <pair>) %tail(p); end method;

//(define-method head-setter ((p <pair>) obj) (%head-setter p obj))
define method head-setter (p :: <pair>, obj)
    %head-setter(p, obj);
end method;

//(define-method tail-setter ((p <pair>) obj) (%tail-setter p obj))
define method tail-setter (p :: <pair>, obj)
    %tail-setter(p, obj);
end method;

//
// synonyms for lisp hackers -- deprecated!
//
//(define-method car ((p <pair>))
//  (princ "warning: car is deprecated by Dylan Design Note 16.")
//  (%head p))
//(define-method cdr ((p <pair>))
//  (princ "warning: cdr is deprecated by Dylan Design Note 16.")
//  (%tail p))
//(define-method cons (car cdr)
//  (princ "warning: cons is deprecated by Dylan Design Note 16.")
//  (%pair car cdr))

//
// generic sequence operations
//

//(define-method add ((l <list>) el) (pair el (copy-sequence l)))
//(define-method add! ((l <list>) el) (pair el l))

define method add(l :: <list>, el)
    pair(el, copy-sequence(l));     // can't share structure.
end method;
define method add!(l :: <list>, el) pair(el, l); end method;

//(define-method add-new ((l <list>) el #key (test id?))
//  (if (not (member? el l test: test))
//      (add l el)
//      l))

//(define-method add-new! ((l <list>) el #key (test id?))
//  (if (not (member? el l test: test))
//      (add! l el)
//      l))

//(define-method remove ((l <list>) el #key (test id?) (count #f))
//  (bind-methods ((help (l el c)
//           (cond
//            ((empty? l) l)
//            ((test (head l) el) (if (and count (>= c count))
//                        (copy-sequence l)
//                        (help (tail l) el (+ c 1))))
//            (else: (pair (head l) (help (tail l) el c))))))
//    (help l el 0)))

//(define-method remove! ((orig <list>) el #key (test id?) (count #f))
//  (bind-methods ((help (lst last c)
//               (cond
//            ((empty? lst) '())
//            ((test (head l) el) (if (and count (>= c count))
//                        lst
//                        (help (tail lst) (head lst) (+ c 1))))
//            (else: ))))))

//(define-method choose ((pred <function>) (l <list>))
//  (cond
//   ((empty? l) l)
//   ((pred (head l)) (pair (head l) (choose pred (tail l))))
//   (else: (choose pred (tail l)))))

//(define-method choose-by ((pred <function>) (test-list <list>) (value-list <list>))
//  (cond
//   ((and (empty? test-list) (empty? value-list)) '())
//   ((or (empty? test-list) (empty? value-list))
//    (error "choose-by: test list and value list have different sizes" test-list value-list))
//   ((pred (head test-list)) (pair (head value-list)
//                  (choose-by pred (tail test-list) (tail value-list))))
//   (else: (choose-by pred (tail test-list) (tail value-list)))))

//(define-method intersection ((l1 <list>) (l2 <list>) #key (test id?))
//  (bind ((res '()))
//    (for ((state (initial-state l1) (next-state l1 state)))
//      ((not state) res)
//      (bind ((cur (current-element l1 state)))
//    (when (member? cur l2 test: test)
//      (set! res (pair cur res)))))))

//(define-method union ((l1 <list>) (l2 <list>) #key (test id?))
//  (for ((state (initial-state l1) (next-state l1 state)))
//      ((not state) l2)
//    (set! l2 (add-new! l2 (current-element l1 state) test: test))))

//(define-method remove-duplicates ((l <list>) #key (test id?))
//  (bind-methods ((help (l)
//                   (cond
//            ((empty? l) '())
//            ((member? (head l) (tail l) test: id?)
//             (help (tail l)))
//            (else: (pair (head l) (help (tail l)))))))
//    (help l)))

//(define-method remove-duplicates! ((l <list>) #key (test id?)) 'unimplemented)

//(define-method copy-sequence ((l <list>))
//  (if (empty? l)
//      l
//      (pair (head l) (copy-sequence (tail l)))))
define method copy-sequence (l :: <list>)
    pair(head(l), copy-sequence(tail(l)));
end method;
define method copy-sequence (l == #())
    #()
end method;

//(define-method concatenate-as ((c <class>) (l <list>) #rest more-sequences) 'unimplemented)

//(define-method append2 ((l1 <list>) (l2 <list>)) (%list-append l1 l2))
define method append2 (l1 :: <list>, l2 :: <list>)
    %list-append(l1, l2);
end method;

//(define-method concatenate ((s <list>) #rest more-sequences)
//  (bind-methods ((help ((s <sequence>) (more <list>))
//                   (if (empty? more)
//               s
//               (help (append2 s (head more))
//                 (tail more)))))
//   (help s more-sequences)))

//(define-method replace-subsequence! ((l <list>) (insert <list>) #key (start 0)) 'unimplemented)

//(define-method reverse ((l <list>)) (%list-reverse l))
//(define-method reverse! ((l <list>)) (%list-reverse! l))

define method reverse (l :: <list>)
    %list-reverse(l);
end method;
define method reverse! (l :: <list>)
    %list-reverse!(l);
end method;

//(define-method sort ((l <list>) #key (test id?)) 'unimplemented)
//(define-method sort! ((l <list>) #key (test id?)) 'unimplemented)

//(define-method first-setter ((l <list>) obj) (%head-setter l obj))
//(define-method second-setter ((l <list>) obj) (head-setter (tail l) obj))
//(define-method third-setter ((l <list>) obj) (head-setter (tail (tail l)) obj))
//(define-method last ((l <list>) #key (default %default-object))
//  (%list-last l default))

//(define-method subsequence-position ((l <list>) pattern #key (test id?) (count 0))
//    'unimplemented)

//
// faster versions collection operations for <list>.
//

//(define-method size ((l <list>)) (%list-length l))
define method size (l :: <list>) %list-length(l); end method;

//(define-method length ((l <list>)) (%list-length l))
define method length (l :: <list>) %list-length(l); end method;

//(define-method empty? ((l <list>)) (id? l '()))
define method empty? (l == #()) #t; end method;
define method empty? (l :: <list>) #f; end method;

//(define-method map1 ((f <function>) (l <list>)) (%list-map1 f l))
define method map1 (f :: <function>, l :: <list>) %list-map1(f, l); end method;

//(define-method map ((f <function>) (l <list>) #rest more-lists)
//  (if (empty? more-lists)
//      (map1 f l)
//      (bind-methods ((help (lists)
//               (if (empty? (head lists))
//                   '()
//                   (pair (apply f (map1 head lists))
//                     (help (map1 tail lists))))))
//            (help (pair l more-lists)))))

define method map (f :: <function>, l :: <list>, #rest more-lists)
    if (empty?(more-lists))
        map1(f, l);
    else
        local method help (lists)
            if (empty?(head(lists)))
                #();
            else
                pair(apply(f, map1(head, lists)), help(map1(tail, lists)));
            end if;
        end help;
        help(pair(l, more-lists));
    end if;
end method;

//(define-method reduce ((f <function>) i (l <list>)) (%list-reduce f i l))
//(define-method reduce1 ((f <function>) (l <list>)) (%list-reduce1 f l))
//(define-method member? (el (l <list>) #key (test id?)) (%list-member? el l test))

define method reduce (f :: <function>, i, l :: <list>)
    %list-reduce(f, i, l);
end method;
define method reduce1 (f :: <function>, l :: <list>)
    %list-reduce1(f, l);
end method;
define method member? (el, l :: <list>, #key test (id?))
    %list-member?(el, l, test);
end method;

// member?(3, #(1,2,3));

//(define-method first ((l <list>) #key (default %default-object))
//  (%first l default))
//(define-method second ((l <list>) #key (default %default-object))
//  (%second l default))
//(define-method third ((l <list>) #key (default %default-object))
//  (%third l default))

define method first (l :: <list>, #key default (%default-object))
    %first(l, default);
end method;
define method second (l :: <list>, #key default (%default-object))
    %second(l, default);
end method;
define method third (l :: <list>, #key default (%default-object))
    %third(l, default);
end method;

//(define-method element ((l <list>) (i <integer>) #key (default %default-object))
//  (%list-element p i default))

define method element (l :: <list>, i :: <integer>, #key default (%default-object))
    %list-element(l, i, default);
end method;

//(define-method element-setter ((l <list>) (i <integer>) val)
//  (%list-element-setter l i val))

define method element-setter (l :: <list>, i :: <integer>, val)
    %list-element-setter(l, i, val);
end method;

//
// iteration protocol
//

//(define-method forward-iteration-protocol ((c <collection>))
//  (values
//   (initial-state c)
//   (%collection-limit c)
//   next-state
//   finished-state?
//   current-key
//   current-element
//   current-element-setter
//   copy-state))

define method forward-iteration-protocol (c :: <collection>)
    values(
        initial-state(c),
        %collection-limit(c),
        next-state,
        finished-state?,
        current-key,
        current-element,
        current-element-setter,
        copy-state);
end method;

//(define-method backward-iteration-protocol ((c <collection>))
//  (values
//   (final-state c)
//   (%collection-limit c)
//   previous-state
//   finished-state?
//   current-key
//   current-element
//   current-element-setter
//   copy-state))

define method backward-iteration-protocol (c :: <collection>)
    values(
        final-state(c),
        %collection-limit(c),
        previous-state,
        finished-state?,
        current-key,
        current-element,
        current-element-setter,
        copy-state);
end method;

//(define-method %collection-limit ((c <collection>)) #f)
define method %collection-limit (c :: <collection>) #f end method;

//(define-method finished-state? ((c <collection>) state limit)
//  (id? state limit))
define method finished-state? (c :: <collection>, state, limit)
    id?(state, limit);
end method;

//(define-method initial-state ((l <list>))
//  (if (id? l '())
//      #f
//      l))

define method initial-state (l :: <list>)
    if (id?(l, #()))
        #f;
    else
        l;
    end if;
end method;

//(define-method next-state ((l <list>) (s <list>))
//  (cond
//   ((empty? s) #f)
//   ((empty? (tail s)) #f)
//   (#t (tail s))))

define method next-state (l :: <list>, state :: <list>)
    case
        empty?(state) => #f;
        empty?(tail(state)) => #f;
        otherwise => tail(state);
    end case;
end method;

define method current-key (c :: <collection>, state)
    error("Don't know how to find current key", c);
end method;

//(define-method current-element ((c <collection>) state)
//   (error "Don't know how to find current element" c))

define method current-element (c :: <collection>, state)
    error("Don't know how to find current element", c);
end method;

//(define-method current-element ((l <list>) (state <list>))
//  (head state))

define method current-element (l :: <list>, state :: <list>)
    head(state);
end method;

//(define-method current-element-setter ((l <list>) (s <pair>) obj)
//  (%head-setter s obj))

define method current-element-setter (l :: <list>, s :: <pair>, obj)
    %head-setter(s, obj);
end method;

//(define-method copy-state ((l <list>) s)
//  (copy-sequence s))

define method copy-state (l :: <list>, s :: <list>)
    copy-sequence(s);
end method;

//
// comparisons
//

//(define-method binary= ((p1 <pair>) (p2 <pair>))
//  (and (binary= (head p1) (head p2))
//       (binary= (tail p1) (tail p2))))

define method \= (p1 :: <pair>, p2 :: <pair>)
    head(p1) = head(p2) & tail(p1) = tail(p2);
end method;

// end list.dyl

//
// range.dyl
//
// range operations
//
//(define-class <range> (<sequence>)
//  (from    init-value:  0 init-keyword: from:)
//  (to      init-value: #f init-keyword: to:)
//  (above   init-value: #f init-keyword: above:)
//  (below   init-value: #f init-keyword: below:)
//  (by      init-value:  1 init-keyword: by:)
//  (size    init-value: #f init-keyword: size:))

//(define-method initialize ((range <range>) #rest args)
//  (bind ((from (from range))
//     (to (to range))
//     (above (above range))
//     (below (below range))
//     (by (by range))
//     (bmax (method (x y) (if x
//                 (max x y)
//                 y))))
//    (if (id? by 0)
//        (size-setter range #f)
//        (bind ((new-size (size range)))
//          (if to
//              (set! new-size
//                (as <integer> (+ (/ (- to from) by) 1)))
//              #f)
//          (if above
//              (if (< by 0)
//              (set! new-size
//                (as <integer> (bmax new-size
//                            (/ (- above from) by))))
//              (set! new-size 0))
//              #f)
//          (if below
//              (if (> by 0)
//              (set! new-size
//                (as <integer> (bmax new-size
//                            (/ (- below from) by))))
//              (set! new-size 0))
//              #f)
//          (if new-size
//              (set! new-size (max new-size 0))
//              #f)
//          (size-setter range new-size)))))

//(define-method range (#rest args) (%apply make (pair <range> args)))

//(define-method element ((range <range>)
//            (index <integer>)
//            #key (default %default-object))
//  (case (size range)
//    ((0) (if (id? default %default-object)
//         (error "element: no elements in range")
//         default))
//    ((#f) (if (>= index 0)
//          (+ (from range) (* (by range) index))
//          (if (id? default %default-object)
//          (error  "element: index out of range" index)
//          default)))
//    (else: (if (or (>= index (size range)) (< index 0))
//           (if (id? default %default-object)
//           (error "element: index out of range" index)
//           default)
//           (+ (from range) (* (by range) index))))))

//(define-method member? (value (range <range>) #key (test id?))
//  (if (id? test id?)
//      (if (id? (element range (as <integer>
//                  (/ (- value (from range)) (by range)))
//            default: default)
//           value)
//      #t
//      #f)
//      (for-each ((x range))
//        ((test x value) #t))))

//(define-method copy-sequence ((r <range>) #key start end)
//  (bind ((s (if start start 0)))
//    (if end
//        (range from: (element r s) size: (+ (- end s) 1)
//           by: (by r))
//        (if (size r)
//        (range from: (element r s) by: (by r) size: (size r))
//        (range from: (element r s) by: (by r))))))

//(define-method binary= ((r1 <range>) (r2 <range>))
//  (and (= (from r1) (from r2))
//       (= (by r1)   (by r2))
//       (= (size r1) (size r2))))

//(define-method =hash ((r <range>))
//  (+ (=hash (from r)) (=hash (by r)) (=hash (size r))))

//(define-method reverse! ((r <range>))
//  (if (size r)
//      (begin
//    (from-setter r (last r))
//    (by-setter r (negative (by r)))
//    (above-setter r #f)
//    (to-setter r #f)
//    (below-setter r #f)
//    r)
//      (error "reverse!: unable to operate on unbounded range")))

//(define-method reverse ((r <range>))
//  (if (size r)
//      (range from: (last r) size: (size r) by: (- (by r)))
//      (error "reverse: unable to operate on unbounded range")))

//
// iteration protocol
//

//(define-method initial-state ((range <range>))
//  (bind ((x (pair #f #f))
//     (result (element range 0 default: x)))
//    (if (id? x result)
//        #f
//        0)))

//(define-method next-state ((range <range>) state)
//  (bind ((x (pair #f #f))
//     (result (element range (+ state 1) default: x)))
//    (if (id? x result)
//        #f
//        (+ state 1))))

//(define-method current-element ((range <range>) state)
//  (element range state))

// end range.dyl

//
// string.dyl
//
// string operations
//

//(define-method element ((s <string>)
//            (i <integer>)
//            #key
//            (default %default-object))
//  (%string-element s i default))
define method element (s :: <string>, i :: <integer>, #key default (%default-object))
    %string-element(s, i, default);
end method;

//(define-method element-setter ((s <string>) (i <integer>) (c <character>))
//  (%string-element-setter s i c))
define method element-setter (s :: <string>, i :: <integer>, c :: <character>)
    %string-element-setter (s, i, c);
end method;

//(define-method size ((s <string>)) (%string-size s))
//(define-method length ((s <string>)) (%string-size s))
//(define-method append2 ((s1 <string>) (s2 <string>)) (%string-append2 s1 s2))
define method size (s :: <string>) %string-size(s); end method;
define method length (s :: <string>) %string-size(s); end method;
define method append2 (s1 :: <string>, s2 :: <string>) %string-append2(s1, s2); end method;

//
// iteration protocol
//

//(define-method initial-state ((s <string>))
//  (if (= (size s) 0)
//      #f
//      0))
define method initial-state (s :: <string>)
    if (size(s) = 0) #f; else 0; end if;
end method;

//(define-method next-state ((s <string>) (state <integer>))
//  (if (< state (- (size s) 1))
//      (+ state 1)
//      #f))
define method next-state (s :: <string>, state :: <integer>)
    if (state < size(s)) state + 1; else #f; end if;
end method;

//(define-method current-element ((s <string>) (state <integer>))
//  (%string-element s state %default-object))
define method current-element (s :: <string>, state :: <integer>)
    %string-element(s, state, %default-object);
end method;

//(define-method current-element-setter ((s <string>) (state <integer>) obj)
//  (%string-element-setter s state obj))
define method current-element-setter (s :: <string>, state :: <integer>, obj)
    %string-element-setter(s, state, obj);
end method;

//(define-method copy-state ((s <string>) (state <integer>)) state)
define method copy-state (s :: <string>, state :: <integer>) state; end method;

// comparisons

//(define-method binary< ((s1 <string>) (s2 <string>))
//  (bind ((result #f))
//    (for ((s1state (initial-state s1) (next-state s1 s1state))
//          (s2state (initial-state s2) (next-state s2 s2state)))
//         ((if (not s1state)
//          (begin (and s2state (set! result #t))
//             #t)
//          (if s2state
//              (if (< (current-element s1 s1state)
//                 (current-element s2 s2state))
//              (begin (set! result #t)
//                 #t)
//              #f)
//              #t))
//          result))))

// <pcb> -- these should use fast primitives rather than iteration protocol.
define method binary< (s1 :: <string>, s2 :: <string>)
    %string-binary<(s1, s2);
end method;

//(define-method binary= ((s1 <string>) (s2 <string>))
//  (and (= (size s1) (size s2)) (every? = s1 s2)))
define method binary= (s1 :: <string>, s2 :: <string>)
    %string-binary=(s1, s2);
end method;

// end string.yl

//
// vector.dyl
//
// Brent Benson
//

//(define-method vector (#rest els) (%vector els))

define method vector (#rest els)
    %vector(els);
end method;

//(define-method element ((v <vector>)
//            (i <integer>)
//            #key (default %default-object))
//  (%vector-element v i default))

define method element (v :: <vector>, i :: <integer>, #key default (%default-object))
    %vector-element(v, i, default);
end method;

//(define-method element-setter ((v <vector>) (i <integer>) obj)
//  (%vector-element-setter v i obj))

define method element-setter (v :: <vector>, i :: <integer>, obj)
    %vector-element-setter(v, i, obj);
end method;

//(define-method size ((v <vector>)) (%vector-size v))

define method size (v :: <vector>) %vector-size(v); end method;

//(define-method dimensions ((v <vector>)) (list (%vector-size v)))

define method dimensions (v :: <vector>) list(%vector-size(v)); end method;

//(define-method length ((v <vector>)) (%vector-size v))

define method length(v :: <vector>) %vector-size(v); end method;

//(define-method append2 ((v1 <vector>) (v2 <vector>)) (%vector-append2 v1 v2))

define method append2(v1 :: <vector>, v2 :: <vector>) %vector-append2(v1, v2); end method;

//
// iteration protocol
//

//(define-method initial-state ((v <vector>))
//  (if (= (size v) 0)
//      #f
//      0))

define method initial-state (v :: <vector>)
    if (size(v) = 0)
        #f;
    else
        0;
    end if;
end method;

//(define-method next-state ((v <vector>) (state <integer>))
//  (if (< state (- (size v) 1))
//      (+ state 1)
//      #f))

define method next-state (v :: <vector>, state :: <integer>)
    if (state < (size(v) - 1))
        state + 1;
    else
        #f;
    end if;
end method;

//(define-method current-element ((v <vector>) (state <integer>))
//  (%vector-element v state %default-object))

define method current-element (v :: <vector>, state :: <integer>)
    %vector-element(v, state, %default-object);
end method;

//(define-method current-element-setter ((v <vector>) (state <integer>) obj)
//  (%vector-element-setter v state obj))

define method current-element-setter (v :: <vector>, state :: <integer>, obj)
    %vector-element-setter(v, state, obj);
end method;

//(define-method copy-state ((v <vector>) (state <integer>)) state)

define method copy-state (v :: <vector>, state :: <integer>) state; end method;

//(define-method previous-state ((v <vector>) (state <integer>))
//  (if (<= state 0)
//      #f
//      (- state 1)))

define method previous-state (v :: <vector>, state :: <integer>)
    if (state > 0)
        state - 1;
    else
        #f;
    end if;
end method;

//(define-method final-state ((v <vector>)) (- (size v) 1))

define method final-state (v :: <vector>) size(v) - 1; end method;

// end vector.dyl

// stretchy-vector
//
// [e-mail]
//

//(define-class <stretchy-vector> (<stretchy-collection> <vector>)
//  (rep type: <vector> )
//  (size init-keyword: size:)
//  (fill init-keyword: fill:))

define class <stretchy-vector> (<stretchy-collection>, <vector>)
    slot rep, type: <vector>;
    slot size, init-keyword: size:, init-value: 0;
    slot fill, init-keyword: fill:, init-value: #f;
end class;

// initialize method.
define method initialize (sv :: <stretchy-vector>, #key, #all-keys)
    next-method();
    sv.rep := make(<vector>, size: sv.size, fill: sv.fill);
end method;

// end stretchy-vector

//
// table.dyl
//
// Brent Benson
//

//(define-method element ((t <table>) key #key (default %default-object))
//  (%table-element t key default))

define method element (t :: <table>, key, #key default (%default-object))
    %table-element(t, key, default);
end method;

//(define-method element-setter ((t <table>) key value) (%table-element-setter t key value))

define method element-setter (t :: <table>, key, value)
    %table-element-setter(t, key, value);
end method;

//(define-method initial-state ((t <table>)) (%table-initial-state t))

define method initial-state (t :: <table>) %table-initial-state(t); end method;

//(define-method next-state ((t <table>) (te <table-entry>)) (%table-next-state t te))

define method next-state (t :: <table>, te :: <table-entry>)
    %table-next-state(t, te);
end method;

//(define-method current-element ((t <table>) (te <table-entry>)) (%table-current-element t te))

define method current-element (t :: <table>, te :: <table-entry>)
    %table-current-element(t, te);
end method;

//(define-method current-element-setter ((t <table>) (te <table-entry>) value)
//  (%table-current-element-setter t te value))

define method current-element-setter (t :: <table>, te :: <table-entry>, value)
    %table-current-element-setter(t, te, value);
end method;

//(define-method current-key ((t <table>) (te <table-entry>)) (%table-current-key t te))

define method current-key (t :: <table>, te :: <table-entry>)
    %table-current-key(t, te);
end method;

//(define-method key-sequence ((t <table>))
//  (bind ((keys '()))
//    (for ((state (initial-state t) (next-state t state)))
//    ((not state) keys)
//      (set! keys (pair (current-key t state) keys)))))

define method key-sequence (t :: <table>)
    let keys = #();
    for (state = initial-state(t) then next-state(t, state) until (~state))
        keys := pair(current-key(t, state), keys);
    finally
        keys;
    end for;
end method;

// end table.dyl

//
// deque.dyl
//
// Brent Benson
//

//(define-method push ((d <deque>) new) (%push d new))
//(define-method pop ((d <deque>)) (%pop d))
//(define-method push-last ((d <deque>) new) (%push-last d new))
//(define-method pop-last ((d <deque>)) (%pop-last d))

define method push (d :: <deque>, new)
    %push(d, new);
end method;
define method pop (d :: <deque>)
    %pop(d);
end method;
define method push-last (d :: <deque>, new)
    %push-last(d, new);
end method;
define method pop-last (d :: <deque>)
    %pop-last(d, new);
end method;

//(define-method first ((d <deque>) #key (default %default-object))
//  (%deque-first d default))

define method first (d :: <deque>, #key default (%default-object))
    %deque-first(d, default);
end method;

//(define-method last ((d <deque>) #key (default %default-object))
//  (%deque-last d default))

define method last (d :: <deque>, #key default (%default-object))
    %deque-last(d, default);
end method;

// should add specific (define-method last-setter ((d <deque>) new-value) ...)
//(define-method element ((d <deque>)
//            (i <integer>)
//            #key (default %default-object))
//  (%deque-element d i default))

define method element (d :: <deque>, i :: <integer>, #key default (%default-object))
    %deque-element(d, i, new);
end method;

//(define-method element-setter ((d <deque>) (i <integer>) new)
//  (%deque-element-setter d i new))

define method element-setter (d :: <deque>, i :: <integer>, new)
    %deque-element-setter(d, i, new);
end method;

//(define-method add! ((d <deque>) new) (%push d new))

define method add! (d :: <deque>, new)
    %push(d, new);
end method;

//
// add remove!
//

//
// iteration protocol
//

//(define-method initial-state ((d <deque>)) (%deque-initial-state d))
//(define-method final-state ((d <deque>)) (%deque-final-state d))

define method initial-state (d :: <deque>)
    %deque-initial-state(d);
end method;
define method final-state (d :: <deque>)
    %deque-final-state(d);
end method;

//(define-method next-state ((d <deque>) (state <deque-entry>))
//  (%deque-next-state d state))
//(define-method previous-state ((d <deque>) (state <deque-entry>))
//  (%deque-previous-state d state))

define method next-state (d :: <deque>, state :: <deque-entry>)
    %deque-next-state(d, state);
end method;
define method previous-state (d :: <deque>, state :: <deque-entry>)
    %deque-previous-state(d, state);
end method;

//(define-method current-element ((d <deque>) (state <deque-entry>))
//  (%deque-current-element d state))
//(define-method current-element-setter ((d <deque>)
//                       (state <deque-entry>)
//                       new-value)
//  (%deque-current-element-setter d state new-value))

define method current-element (d :: <deque>, state :: <deque-entry>)
    %deque-current-element(d, state);
end method;
define method current-element-setter (d :: <deque>, state :: <deque-entry>, new-value)
    %deque-current-element-setter(d, state, newvalue);
end method;

// end deque.dyl

//
// array.dyl
//
// Brent Benson
//

// need to add default

//(define-method element ((a <array>)
//            (indices <list>)
//            #key (default %default-object))
//  (%array-element a indices default))
//(define-method element-setter ((a <array>) (inds <list>) new-value)
//  (%array-element-setter a inds new-value))

define method element (a :: <array>, indices :: <list>, #key default (%default-object))
    %array-element(a, indices, default);
end method;
define method element-setter (a :: <array>, indices :: <list>, new-value)
    %array-element-setter(a, indices, default);
end method;

//(define-method dimensions ((a <array>)) (%array-dimensions a))
//(define-method size ((a <array>)) (reduce * 1 (%array-dimensions a)))
//(define-method rank ((a <array>)) (length (%array-dimensions a)))
//(define-method row-major-index ((a <array>) #rest subscripts)
//  (%array-row-major-index a subscripts))

define method dimensions (a :: <array>)
    %array-dimensions(a);
end method;
define method size (a :: <array>)
    reduce(\*, 1, %array-dimensions(a));
end method;
define method rank (a :: <array>)
    length(%array-dimensions(a));
end method;
define method row-major-index(a :: <array>, #rest subscripts)
    %array-row-major-index(a, subscripts);
end method;

//(define-method aref ((a <array>) #rest indices) (%array-element a indices %default-object))

define method aref (a :: <array>, #rest indices)
    %array-element(a, indices, %default-object);
end method;

//(define-method aref-setter ((a <array>) #rest indicies-and-val)
//  (bind-methods ((but-last (lst)
//           (cond
//            ((empty? lst) '())
//            ((empty? (tail lst)) '())
//            (else: (pair (head lst) (but-last (tail lst)))))))
//    (bind ((new-val (last indicies-and-val))
//       (indicies (but-last indicies-and-val)))
//      (%array-element-setter a indicies new-val))))

define method aref-setter (a :: <array>, #rest indicies-and-val)
    local method except-last (lst)
        if (empty?(lst) | empty?(tail(lst)))
            #();
        else
            pair(head(lst), except-last(tail(lst)));
        end if;
    end but-last;
    let new-val = last(indicies-and-val);
    let indicies = except-last(indicies-and-val);
    %array-element-setter(a, indicies, new-val);
end method;

//(define-method dimension ((array <array>) (axis <integer>))
//  (element (dimensions array) axis))

define method dimension (a :: <array>, axis :: <integer>)
    dimensions(a)[axis];
end method;

//
// iteration protocol
//

//(define-method initial-state ((a <array>)) (%array-initial-state a))
//(define-method next-state ((a <array>) (s <integer>))
//  (%array-next-state a s))

define method initial-state (a :: <array>)
    %array-initial-state(a);
end method;

define method next-state (a :: <array>, state :: <integer>)
    %array-next-state(a, state);
end method;

//(define-method current-element ((a <array>) (s <integer>))
//  (%array-current-element a s))

define method current-element (a :: <array>, state :: <integer>)
    %array-current-element(a, state);
end method;

// end array.dyl

//
// numbers
//

//
// number.dyl - generic functions on numbers
//
// Brent Benson
//

//
// misc
//
//(define-method odd? ((i <integer>)) (%odd? i))
//(define-method even? ((i <integer>)) (%even? i))
//(define-method zero? ((i <integer>)) (%int-zero? i))
//(define-method zero? ((d <double-float>)) (%double-zero? d))
//(define-method positive? ((i <integer>)) (%int-positive? i))
//(define-method positive? ((d <double-float>)) (%double-positive? d))
//(define-method negative? ((i <integer>)) (%int-negative? i))
//(define-method negative? ((d <double-float>)) (%double-negative? d))
//(define-method integral? ((n <number>)) (%integral? n))
//(define-method quotient ((i1 <integer>) (i2 <integer>)) (%quotient i1 i2))

define method odd? (i :: <integer>) %odd?(i); end method;
define method even? (i :: <integer>) %even?(i); end method;
define method zero? (i :: <integer>) %int-zero?(i); end method;
define method zero? (d :: <double-float>) %double-zero?(d); end method;
define method positive? (i :: <integer>) %int-positive?(i); end method;
define method positive? (d :: <double-float>) %double-positive?(d); end method;
define method negative? (i :: <integer>) %int-negative?(i); end method;
define method negative? (d :: <double-float>) %double-negative?(d); end method;
define method integral? (n :: <number>) %integral?(n); end method;
define method quotient (i1 :: <integer>, i2 :: <integer>) %quotient?(i1, i2); end method;

//
// coercions
//
//(define-method as ((df-class (singleton <double-float>)) (i <integer>))
//  (%int-to-double i))

define method as (df-class == <double-float>, i :: <integer>)
    %int-to-double(i);
end method;

//(define-method as ((int-class (singleton <integer>)) (df <double-float>))
//  (%double-to-int df))

define method as (df-class == <integer>, df :: <double-float>)
    %double-to-int(df);
end method;

//
// multi-argument versions (?)
//

//(define-method + ((n1 <number>) (n2 <number>)) (binary+ n1 n2))
//(define-method * ((n1 <number>) (n2 <number>)) (binary* n1 n2))

define method \+ (n1 :: <number>, n2 :: <number>)
    binary+(n1, n2);
end method;
define method \* (n1 :: <number>, n2 :: <number>)
    binary*(n1, n2);
end method;

//(define-method negative ((i <integer>)) (%int-negative i))
//(define-method negative ((d <double-float>)) (%double-negative d))

define method negative (i :: <integer>) %int-negative(i); end method;
define method negative (d :: <double-float>) %double-negative(d); end method;

//(define-method - ((n1 <number>) (n2 <number>))
//  (binary- n1 n2))

define method \- (n1 :: <number>, n2 :: <number>)
    binary-(n1, n2);
end method;

//(define-method unary/ ((i <integer>)) (%int-inverse i))
//(define-method unary/ ((d <double-float>)) (%double-inverse d))
//(define-method / ((n1 <number>) (n2 <number>))
//   ( binary/ n1 n2))

define method unary/ (i :: <integer>) %int-inverse(i); end method;
define method unary/ (d :: <double-float>) %double-inverse(i); end method;
define method \/ (n1 :: <number>, n2 :: <number>)
    binary/(n1, n2);
end method;

//
// (op <integer> <integer>)
// <integer> op <integer>
//

//(define-method binary+ ((i1 <integer>) (i2 <integer>))
//  (%binary-int+ i1 i2))

define method binary+ (i1 :: <integer>, i2 :: <integer>)
    %binary-int+(i1, i2);
end method;

//(define-method binary- ((i1 <integer>) (i2 <integer>))
//  (%binary-int- i1 i2))

define method binary- (i1 :: <integer>, i2 :: <integer>)
    %binary-int-(i1, i2);
end method;

//(define-method binary* ((i1 <integer>) (i2 <integer>))
//  (%binary-int* i1 i2))

define method binary* (i1 :: <integer>, i2 :: <integer>)
    %binary-int*(i1, i2);
end method;

//(define-method binary/ ((i1 <integer>) (i2 <integer>))
//  (%binary-int/ i1 i2))

define method binary/ (i1 :: <integer>, i2 :: <integer>)
    %binary-int/(i1, i2);
end method;

//
// (op <double-float> <double-float>)
// <double-float> op <double-float>
//

//(define-method binary+ ((d1 <double-float>) (d2 <double-float>))
//  (%binary-double+ d1 d2))
define method binary+ (d1 :: <double-float>, d2 :: <double-float>)
    %binary-double+(d1, d2);
end method;

//(define-method binary- ((d1 <double-float>) (d2 <double-float>))
//  (%binary-double- d1 d2))
define method binary- (d1 :: <double-float>, d2 :: <double-float>)
    %binary-double-(d1, d2);
end method;

//(define-method binary* ((d1 <double-float>) (d2 <double-float>))
//  (%binary-double* d1 d2))
define method binary* (d1 :: <double-float>, d2 :: <double-float>)
    %binary-double*(d1, d2);
end method;

//(define-method binary/ ((d1 <double-float>) (d2 <double-float>))
//  (%binary-double/ d1 d2))
define method binary/ (d1 :: <double-float>, d2 :: <double-float>)
    %binary-double/(d1, d2);
end method;

//
// (op <integer> <double-float>)
// <integer> op <double-float>
//

//(define-method binary+ ((i1 <integer>) (d2 <double-float>))
//  (%binary-double+ (as <double-float> i1) d2))

define method binary+ (i1 :: <integer>, d2 :: <double-float>)
    %binary-double+(as(<double-float>, i1), d2);
end method;

//(define-method binary- ((i1 <integer>) (d2 <double-float>))
//  (%binary-double- (as <double-float> i1) d2))

define method binary- (i1 :: <integer>, d2 :: <double-float>)
    %binary-double-(as(<double-float>, i1), d2);
end method;

//(define-method binary* ((i1 <integer>) (d2 <double-float>))
//  (%binary-double* (as <double-float> i1) d2))

define method binary* (i1 :: <integer>, d2 :: <double-float>)
    %binary-double*(as(<double-float>, i1), d2);
end method;

//(define-method binary/ ((i1 <integer>) (d2 <double-float>))
//  (%binary-double/ (as <double-float> i1) d2))

define method binary/ (i1 :: <integer>, d2 :: <double-float>)
    %binary-double/(as(<double-float>, i1), d2);
end method;

//
// (op <double-float> <integer>)
//
//(define-method binary+ ((d1 <double-float>) (i2 <integer>))
//  (%binary-double+ d1 (as <double-float> i2)))

define method binary+ (d1 :: <double-float>, i2 :: <integer>)
    %binary-double+(d1, as(<double-float>, i2));
end method;

//(define-method binary- ((d1 <double-float>) (i2 <integer>))
//  (%binary-double- d1 (as <double-float> i2)))

define method binary- (d1 :: <double-float>, i2 :: <integer>)
    %binary-double-(d1, as(<double-float>, i2));
end method;

//(define-method binary* ((d1 <double-float>) (i2 <integer>))
//  (%binary-double* d1 (as <double-float> i2)))

define method binary* (d1 :: <double-float>, i2 :: <integer>)
    %binary-double*(d1, as(<double-float>, i2));
end method;

//(define-method binary/ ((d1 <double-float>) (i2 <integer>))
//  (%binary-double/ d1 (as <double-float> i2)))

define method binary/ (d1 :: <double-float>, i2 :: <integer>)
    %binary-double/(d1, as(<double-float>, i2));
end method;

//
// comparisons
//

//(define-method binary= ((n1 <number>) (n2 <number>))
//  (id? n1 n2))

// default \= for <object> suffices. binary= is obsolete. it
// should instead be \=.

//(define-method binary= ((i <integer>) (d <double-float>))
//  (id? (as <double-float> i) d))

define method \= (i :: <integer>, d :: <double-float>)
    as(<double-float>, i) == d;
end method;

// (define-method binary= ((d <double-float>) (i <integer>))
//  (id? d (as <double-float> i)))

define method \= (d :: <double-float>, i :: <integer>)
    d == as(<double-float>, i);
end method;

//(define-method binary< ((n1 <number>) (n2 <number>))
//  (%binary-less-than n1 n2))

define method \< (n1 :: <number>, n2 :: <number>)
    %binary-less-than(n1, n2);
end method;

//(define-method max ((n1 <real>) #rest more-reals)
//  (bind-methods ((help ((n1 <real>) more)
//           (if (empty? more)
//               n1
//               (bind ((n2 (head more))
//                  (largest (if (binary< n1 n2) n2 n1)))
//             (help largest (tail more))))))
//    (help n1 more-reals)))

//define method max (n1 :: <real>, #rest more-reals)
//    local method help (n1 :: <real>, more)
//        if (empty?(more))
//            n1;
//        else
//            let n2 = head(more);
//            let largest = if (n1 > n2) n1 else n2; end if;
//            help(largest, tail(more));
//        end if;
//    end help;
//    help(n1, more-reals);
//end method;

// more imperatively... (i.e. faster)
define method max (n1 :: <real>, #rest more-reals)
    let largest = n1;
    until (more-reals == #())
        let n = head(more-reals);
        if (n > largest)
            largest := n;
        end if;
        more-reals := tail(more-reals);
    end until;
    largest;
end method;

//(define-method min ((n1 <real>) #rest more-reals)
//  (bind-methods ((help ((n1 <real>) more)
//           (if (empty? more)
//               n1
//               (bind ((n2 (head more))
//                  (smallest (if (binary< n1 n2) n1 n2)))
//             (help smallest (tail more))))))
//    (help n1 more-reals)))

//define method min (n1 :: <real>, #rest more-reals)
//    local method help (n1 :: <real>, more)
//        if (empty?(more))
//            n1;
//        else
//            let n2 = head(more);
//            let smallest = if (n1 < n2) n1 else n2; end if;
//            help(smallest, tail(more));
//        end if;
//    end help;
//    help(n1, more-reals);
//end method;

define method min (n1 :: <real>, #rest more-reals)
    let smallest = n1;
    until (more-reals == #())
        let n = head(more-reals);
        if (n < smallest)
            smallest := n;
        end if;
        more-reals := tail(more-reals);
    end until;
    smallest;
end method;

//
// other functions
//

//(define-method sqrt ((i <integer>)) (%int-sqrt i))
// (define-method sqrt ((d <double-float>)) (%double-sqrt d))

define method sqrt (i :: <integer>)
    %int-sqrt(i);
end method;
define method sqrt (d :: <double-float>)
    %double-sqrt(d);
end method;

// (define-method abs ((i <integer>)) (%int-abs i))
// (define-method abs ((d <double-float>)) (%double-abs d))

define method abs (i :: <integer>)
    %int-abs(i);
end method;
define method abs (d :: <double-float>)
    %double-abs(d);
end method;

//(define-method ash ((i <integer>) (count <integer>)) (%ash i count))

define method ash (i :: <integer>, count :: <integer>)
    %ash(i, count);
end method;

//(define-method sin ((n <number>)) (%sin (as <double-float> n)))
//(define-method cos ((n <number>)) (%cos (as <double-float> n)))

define method sin (n :: <number>)
    %sin(as(<double-float>, n));
end method;
define method cos (n :: <number>)
    %cos(as(<double-float>, n));
end method;

//(define-method atan2 ((n1 <number>) (n2 <number>))
//     (%atan2 (as <double-float> n1) (as <double-float> n2)))

define method atan2 (n1 :: <number>, n2 :: <number>)
    %atan2(as(<double-float>, n1), as(<double-float>, n2));
end method;

//(define-method logior (#rest integers) (reduce1 %binary-logior integers))
//(define-method logand (#rest integers) (reduce1 %binary-logand integers))
//(define-method truncate ((n <number>)) (%truncate (as <double-float> n)))
//(define-method modulo ((i1 <number>) (i2 <number>))
//   (%modulo i1 i2))

// exp and ln.
//(define-method exp ((n <number>)) (%exp (as <double-float> n)))
//(define-method ln ((n <number>)) (%ln (as <double-float> n)))

define method exp (n :: <number>)
    %exp(as(<double-float>, n));
end method;
define method ln (n :: <number>)
    %ln(as(<double-float>, n));
end method;

define method \^ (n1 :: <number>, n2 :: <number>)
    %pow(as(<double-float>, n1), as(<double-float>, n2));
end method;

// end number.dyl

//
// characters
//

//
// character.dyl
//
// Brent Benson
//

//(define-method as ((ic (singleton <integer>)) (ch <character>))
//  (%character->integer ch))

define method as (ic == <integer>, ch :: <character>)
    %character->integer(ch);
end;

//(define-method as ((cc (singleton <character>)) (i <integer>))
//  (%integer->character i))

define method as (cc == <character>, i :: <integer>)
    %integer->character(i);
end;

// comparisons

//(define-method binary< ((c1 <character>) (c2 <character>))
//  (binary< (as <integer> c1) (as <integer> c2)))

define method \< (c1 :: <character>, c2 :: <character>)
    as(<integer>, c1) < as(<integer>, c2);
end method;

// functionals

//(define-method compose ((function <function>)
//            #rest more-functions)
//  (if (empty? more-functions)
//      function
//      (method ( #rest args)
//          (function (apply (apply compose (car more-functions)
//                      (cdr more-functions))
//                   args)))))

define method compose(function :: <function>, #rest more-functions)
    if (empty?(more-functions))
        function;
    else
        method (#rest args)
            function(apply(apply(compose, head(more-functions), tail(more-functions)), args));
        end;
    end;
end method;

//(define-method complement ((function <function>))
//  (method (#rest args) (not (apply function args))))
define method complement (f :: <function>)
    method (#rest args)
        ~(apply(func, args));
    end;
end method;

//(define-method disjoin ((function <function>) #rest functions)
//;
//; Not very efficient, but works --  jnw
//;
//  (method (#rest args)
//      (if (empty? functions)
//          (apply function args)
//          (or (apply function args)
//          (apply (apply disjoin functions) args)))))

define method disjoin (func :: <function>, #rest functions)
    method (#rest args)
        let disjunction = %apply(func, args);
        let fns = functions;
        while ((~disjunction) & (fns ~= #()))
            disjunction := %apply(head(fns), args);
            fns := tail(fns);
        end while;
        disjunction;
    end;
end method;

//(define-method conjoin ((function <function>) #rest functions)
//; Not very efficient, but works -- jnw
//  (method (#rest args)
//      (if (empty? functions)
//          (apply function args)
//          (and (apply function args)
//           (apply (apply conjoin functions) args)))))

//(define-method curry ((f <function>)
//              #rest curried-args)
//  (method (#rest regular-args)
//      (apply f (concatenate curried-args regular-args))))

//(define-method rcurry ((f <function>)
//              #rest curried-args)
//  (method (#rest regular-args)
//      (apply f (concatenate regular-args curried-args))))

//(define-method always ((obj <object>))
//  (method (#rest args) obj))

// eof
// princ("at eof.");